home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The 640 MEG Shareware Studio 2
/
The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO
/
basic
/
qbnws201.zip
/
Z.BAS
< prev
Wrap
BASIC Source File
|
1991-01-08
|
19KB
|
342 lines
REM Z.BAS Copyright 1990
REM by Charles Graham, POB 58634, St. Louis, MO 63158
'
'Z.BAS is an elementary communications program written in
'Microsoft QuickBASIC 4.5. It opens the computer's console
'(CON) as a file and funnels all screen writes through CON.
'If a user has ANSI.SYS installed properly, this technique
'makes Z.BAS compatible with Bulletin Board Systems that use
'ANSI escape sequences to produce color and animation on their
'user's screens.
'
'There are only a few requirements for running Z.BAS:
' 1) use an IBM-compatible computer with at least
' 128K of available RAM
' 2) use a Hayes-compatible modem
' 3) use a color monitor and video board
' 4) call a BBS using modem parameters of N,8,1 (no
' parity, 8 data bits, 1 stop bit) unless you want
' to change the code in SUB getparms
' 5) install ANSI.SYS if not already installed.
'
DECLARE SUB bottomline () 'Prints line 25
DECLARE SUB delay () 'Wastes time
DECLARE SUB getparms () 'You need these
DECLARE SUB hangup () 'Byebye, BBS
DECLARE SUB initialize () 'Foreplay
DECLARE SUB makeacall () 'Reach out & touch
DECLARE SUB opencomport () 'Open Sesame
DECLARE SUB outtahere () 'I quit!
'
DIM SHARED ao$ 'Lots of SUBs
DIM SHARED cs$ ' need these so
DIM SHARED bp$ ' SHARE
DIM SHARED comport$ '
DIM SHARED comspec$ '
DIM SHARED es$ '
DIM SHARED dialmode$ '
DIM SHARED firsttime$ '
DIM SHARED init$ '
DIM SHARED hc$ '
ON ERROR GOTO errorroutine 'Just in case
DEFINT A-Z 'Speeds things up
es$ = CHR$(27) 'ESCape
ao$ = es$ + "[0m" 'Attributes off
cs$ = es$ + "[2J" 'Clear screen
f1$ = CHR$(0) + CHR$(59) 'F1 key
f10$ = CHR$(0) + CHR$(68) 'F10 key
ff$ = CHR$(12) 'Form feed
hc$ = es$ + "[f" 'Home cursor
OPEN "con" FOR OUTPUT AS 2 'Console as file
CALL initialize 'Foreplay
PRINT #2, ao$; 'Attributes off
PRINT #2, cs$ + " " + hc$; 'Home cursor
CALL getparms 'You need these
CALL opencomport 'Open Sesame
CALL bottomline 'Print line 25
DO 'Begin endless loop
a$ = INKEY$ 'Check keyboard
IF a$ <> "" THEN 'Key pressed?
SELECT CASE a$ 'What do I do now?
CASE es$ 'ESCape key?
CALL hangup ' Byebye, BBS
CASE f1$ 'F1 key?
CALL makeacall ' Reach out & touch
CASE f10$ 'F10 key?
CALL outtahere ' I quit!
CASE ELSE 'Some other key?
PRINT #1, a$; ' Send it to modem
END SELECT '
END IF '
WHILE NOT EOF(1) 'Characters arrived?
b$ = INPUT$(LOC(1), #1) 'Receive characters
WHILE INSTR(b$, ff$) <> 0 'If an ASCII form
q = INSTR(b$, ff$) ' feed is received
b$ = LEFT$(b$, q - 1) + cs$ + MID$(b$, q + 1)
' change it to ANSI
WEND '
PRINT #2, b$; 'Print characters
a$ = INKEY$ 'Check keyboard
IF a$ <> "" THEN 'Key pressed?
SELECT CASE a$ 'What do I do now?
CASE es$ 'ESCape key?
CALL hangup ' Byebye, BBS
CASE f1$ 'F1 key?
CALL makeacall ' Reach out & touch
CASE f10$ 'F10 key?
CALL outtahere ' I quit!
CASE ELSE 'Some other key?
PRINT #1, a$; ' Send it to modem
END SELECT '
END IF '
WEND '
LOOP 'End endless loop
'
errorroutine: 'Who knows what evil
PRINT "Error type"; ERR; "occurred!" 'lurks within the
RESUME NEXT 'hearts of computers?
SUB bottomline 'Prints line 25
PRINT #2, cs$; 'Clear screen
PRINT #2, es$ + "[25;1f"; 'LOCATE 25, 1
PRINT #2, es$ + "[1;37;44m"; 'Bright white on blue
PRINT #2, "Z QB Dialer Copr. 1990 by Charles Graham ";
PRINT #2, es$ + "[1;33m"; 'Yellow on blue
PRINT #2, " ESC Hang Up F1 Dial F10 End";
PRINT #2, ao$; 'Attributes off
PRINT #2, hc$ + " " + hc$; 'Home cursor
END SUB '
SUB delay 'Wastes time
now! = TIMER '"now!" needs to be
WHILE TIMER - now! < 1.5 ' a SINGLE precision
WEND ' variable
END SUB '
SUB getparms 'You need these
PRINT #2, cs$; 'Clear screen
IF firsttime$ = "on" THEN 'Skip this if it's
firsttime$ = "off" ' your first call;
ELSE ' otherwise:
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, hc$; 'Home cursor
PRINT #2, "Modem speed "; 'Prompt for bps
PRINT #2, es$ + "[1;33m"; 'Yellow
PRINT #2, "3"; '
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "00 "; '
PRINT #2, es$ + "[1;33m"; 'Yellow
PRINT #2, "1"; '
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "200 "; '
PRINT #2, es$ + "[1;33m"; 'Yellow
PRINT #2, "2"; '
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "400 "; '
PRINT #2, es$ + "[1;33m"; 'Yellow
PRINT #2, "9"; '
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "600 ["; '
PRINT #2, es$ + "[1;33m"; 'Yellow
PRINT #2, "1"; '
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "/"; '
PRINT #2, es$ + "[1;33m"; 'Yellow
PRINT #2, "2"; '
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "/"; '
PRINT #2, es$ + "[1;33m"; 'Yellow
PRINT #2, "3"; '
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "/"; '
PRINT #2, es$ + "[1;33m"; 'Yellow
PRINT #2, "9"; '
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "]? "; '
PRINT #2, es$ + "[1;33m"; 'Yellow
bp$ = "" 'Initialize to null
WHILE bp$ <> "1" AND bp$ <> "2" AND bp$ <> "3" AND bp$ <> "9"
bp$ = INKEY$ 'Wait for 1, 2, 3
WEND ' or 9 to be pressed
comspec$ = "COM" + comport$ + ":" 'Initialize comspec
SELECT CASE bp$ 'Whadda we got?
CASE "1" '1 pressed?
PRINT #2, "1200 bps"; ' Tell user
comspec$ = comspec$ + "1200" ' Add 1200 to comspec
CASE "2" '2 pressed?
PRINT #2, "2400 bps"; ' Tell user
comspec$ = comspec$ + "2400" ' Add 2400 to comspec
CASE "3" '3 pressed?
PRINT #2, "300 bps"; ' Tell user
comspec$ = comspec$ + "300" ' Add 300 to comspec
CASE "9" '9 pressed?
PRINT #2, "9600 bps"; ' Tell user
comspec$ = comspec$ + "9600" ' Add 9600 to comspec
END SELECT '
comspec$ = comspec$ + ",N,8,1,DS" 'Complete comspec
END IF '
END SUB '
SUB hangup 'Byebye, BBS
PRINT #2, cs$; 'Clear screen
PRINT #2, es$ + "[1;5;37;41m"; 'Blink white on red
PRINT #2, es$ + "[25;39H"; 'LOCATE 25, 39
PRINT #2, "Wait"; 'Tell user
CALL delay 'Waste time
PRINT #1, "+++"; 'Wake up your modem
CALL delay 'Waste time
PRINT #1, "ATH0" 'Tell modem to hangup
PRINT #2, ao$; 'Attributes off
IF NOT EOF(1) THEN 'Clear the com buffer
b$ = INPUT$(LOC(1), #1) ' of any unprocessed
END IF ' bytes
CALL bottomline 'Print line 25
END SUB '
SUB initialize 'Foreplay
PRINT #2, ao$; 'Attributes off
PRINT #2, cs$; 'Clear screen
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "Modem initialization string? "; 'Prompt user
PRINT #2, es$ + "[1;33m"; 'Yellow
a$ = "" 'Initialize to null
WHILE a$ <> CHR$(13) 'Until Return pressed
a$ = INKEY$ 'Grab key pressed
IF a$ = CHR$(8) AND LEN(init$) THEN 'Backspace?
PRINT #2, es$ + "[1D"; ' Lop off the right-
PRINT #2, " "; ' most character and
PRINT #2, es$ + "[1D"; ' move cursor left
IF LEN(init$) > 1 THEN ' Truncate init$
init$ = LEFT$(init$, LEN(init$) - 1)'by one character
ELSE ' or
init$ = "" ' make it null
END IF '
ELSE '
a$ = UCASE$(a$) 'Make it upper case
IF a$ > " " THEN 'Reject strange chars
init$ = init$ + a$ 'Add char to init$
PRINT #2, a$; 'Print the character
END IF '
END IF '
WEND '
PRINT #2, cs$; 'Clear screen
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "Comm Port ["; 'Prompt user
PRINT #2, es$ + "[1;33m"; 'Yellow
PRINT #2, "1"; '
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "/"; '
PRINT #2, es$ + "[1;33m"; 'Yellow
PRINT #2, "2"; '
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "]? "; '
PRINT #2, es$ + "[1;33m"; 'Yellow
WHILE comport$ <> "1" AND comport$ <> "2" 'Wait for a 1 or 2
comport$ = INKEY$ ' to be pressed
WEND '
PRINT #2, comport$; 'Tell user
PRINT #2, cs$; 'Clear screen
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "DIAL "; 'Prompt user
PRINT #2, es$ + "[1;33m"; 'Yellow
PRINT #2, "P"; '
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "ulse or "; '
PRINT #2, es$ + "[1;33m"; 'Yellow
PRINT #2, "T"; '
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "one ["; '
PRINT #2, es$ + "[1;33m"; 'Yellow
PRINT #2, "P"; '
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "/"; '
PRINT #2, es$ + "[1;33m"; 'Yellow
PRINT #2, "T"; '
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "]? "; '
WHILE dialmode$ <> "P" AND dialmode$ <> "T" 'Wait for a P or T
dialmode$ = INKEY$ ' to be pressed
dialmode$ = UCASE$(dialmode$) 'Make it upper case
WEND '
PRINT #2, es$ + "[1;33m"; 'Yellow
IF dialmode$ = "P" THEN 'P pressed?
PRINT #2, "Pulse"; ' Print Pulse
ELSE 'else
PRINT #2, "Tone"; ' Print Tone
END IF '
END SUB '
SUB makeacall 'Reach out & touch
PRINT #2, cs$; 'Clear screen
PRINT #2, es$ + "[1;5;37;41m"; 'Blink white on red
PRINT #2, es$ + "[25;39H"; 'LOCATE 25, 39
PRINT #2, "Wait"; 'Tell user
CALL delay 'Waste time
PRINT #1, "+++"; 'Wake up your modem
CALL delay 'Waste time
PRINT #1, "ATH0" 'Tell modem to hangup
PRINT #2, ao$; 'Attributes off
IF NOT EOF(1) THEN 'Clear the com buffer
b$ = INPUT$(LOC(1), #1) ' of any unprocessed
END IF ' bytes
CALL getparms 'You need these
CALL opencomport 'Open Sesame
PRINT #2, cs$; 'Clear screen
PRINT #2, es$ + "[1;36m"; 'Light cyan
PRINT #2, "Phone number? "; 'Prompt user
PRINT #2, es$ + "[1;33m"; 'Yellow
dial$ = "" 'Initialize to null
WHILE a$ <> CHR$(13) 'Until Return pressed
a$ = INKEY$ 'Grab key pressed
IF a$ = CHR$(8) AND LEN(dial$) THEN 'Backspace?
PRINT #2, es$ + "[1D"; ' Lop off the right-
PRINT #2, " "; ' most character and
PRINT #2, es$ + "[1D"; ' move cursor left
IF LEN(dial$) > 1 THEN ' Truncate dial$ by
dial$ = LEFT$(dial$, LEN(dial$) - 1)' one character
ELSE ' or
dial$ = "" ' make it null
END IF '
ELSE '
a$ = UCASE$(a$) 'Make it upper case
IF a$ > " " THEN 'Reject strange chars
dial$ = dial$ + a$ 'Add char to dial$
PRINT #2, a$; 'Print the character
END IF '
END IF '
WEND '
PRINT #1, "ATD" + dialmode$ + dial$ 'Tell modem to dial
PRINT #2, ao$; 'Attributes off
PRINT #2, cs$ + " " + hc$; 'Clear screen
END SUB '
SUB opencomport 'Open Sesame
CLOSE #1 'Close com port
OPEN comspec$ FOR RANDOM AS 1 'Open com port
IF firsttime$ = "" THEN 'First time?
PRINT #1, init$ ' Send init$ to modem
firsttime$ = "on" ' Remember you did so
END IF '
END SUB '
SUB outtahere 'I quit!
PRINT #2, cs$; 'Clear screen
PRINT #2, es$ + "[1;5;37;41m"; 'Blink white on red
PRINT #2, es$ + "[25;39H"; 'LOCATE 25, 39
PRINT #2, "Wait"; 'Tell user
CALL delay 'Waste time
PRINT #1, "+++"; 'Wake up your modem
CALL delay 'Waste time
PRINT #1, "ATH0" 'Tell modem to hangup
IF NOT EOF(1) THEN 'Clear the com buffer
b$ = INPUT$(LOC(1), #1) ' of any unprocessed
END IF ' bytes
CLOSE #1 'Close com port
PRINT #2, ao$; 'Attributes off
PRINT #2, cs$ + " " + hc$; 'Clear screen
CLOSE #2 'Close "con"
b$ = "" 'Make b$ null
END 'T-T-That's All Folks
END SUB '
